home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / win / pascal / statdmo.exe / STATUS.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-12-06  |  3.2 KB  |  133 lines
  1. UNIT STATUS;
  2.  
  3. interface
  4. uses wobjects, wintypes,winprocs;
  5. type
  6.     pStatusBar = ^TStatusBar;
  7.     TStatusBar = object(Twindow)
  8.         CurrentID : integer;
  9.         childHeight : integer;
  10.         hmenuSystem : HMENU;
  11.         hmenufile     : Hmenu;
  12.         hmenuEdit    : hmenu;
  13.         constructor Init(AParent: PWindowsObject);
  14.         function GetClassName: PChar; virtual;
  15.         procedure SetupWindow; virtual;
  16.         procedure GetWindowClass(var AWndClass:TWndClass); virtual;
  17.         Procedure Adjustsize(parentWidth, ParentHeight : word);
  18.         procedure DisplayString(resourceID :integer);
  19.         procedure WMMenuSelect(var MSG : TMessage); virtual
  20.             WM_FIRST + WM_Menuselect;
  21.         procedure Paint(PaintDC: HDC; var PaintInfo: TPaintStruct); virtual;
  22.     end;
  23. implementation
  24.  
  25. constructor TStatusBar.init(Aparent : pwindowsobject);
  26. begin
  27.     TWindow.init(Aparent,'');
  28.     Attr.Style := WS_Child + WS_Visible + WS_border;
  29.     Attr.x := 0;
  30.     Attr.y := 0;
  31.     Attr.w := 0;
  32.     attr.h := 0;
  33.     currentID := 0;
  34.     if (Aparent = nil) then
  35.         Status := EM_INVALIDCHILD;
  36. end;
  37.  
  38. procedure TStatusBar.SetupWindow;
  39. var
  40.     sbdc : HDC;
  41.     tm : TTextMetric;
  42.     ParMenu : Hmenu;
  43. begin
  44.     Twindow.setupwindow;
  45.     sbdc := GetDC(Hwindow);
  46.     GetTextMetrics(sbdc, tm);
  47.     ReleaseDC(Hwindow,sbdc);
  48.     childheight := tm.tmheight + (tm.tmheight DIV 3);
  49.     ParMenu := GetMenu(hwnd(Parent));
  50.     hmenuSystem :=GetSystemMenu(hwnd(Parent),FALSE);
  51.     hmenufile     :=GetSubMenu(ParMenu,0);
  52.     hmenuEdit    := GetSubMenu(Parmenu,1);
  53. end;
  54. function TStatusBar.GetClassName: PChar;
  55. begin
  56.     GetClassName := 'TStatusBar';
  57. end;
  58.  
  59. procedure TStatusBar.GetWindowClass(var AWndClass : TWndClass);
  60. begin
  61.     Twindow.GetWindowClass(AWndClass);
  62.     AwndClass.hbrBackground := GetStockObject(LTGRAY_BRUSH);
  63. end;
  64.  
  65. Procedure TStatusBar.Adjustsize(parentWidth, ParentHeight : word);
  66. var
  67.     x,y : integer;
  68. begin
  69.     x := 0;
  70.     y := parentHeight - childHeight + 1;
  71.     MoveWindow(HWindow, x,y,parentWidth,ChildHeight,TRUE);
  72. end;
  73.  
  74. procedure TStatusBar.WMMenuSelect(var MSG : TMessage);
  75. var
  76.     wIDItem,fwMenu : Hmenu;
  77.     hMen : HMenu;
  78.     resourceID : integer;
  79.     menuClosing  : Boolean;
  80. begin
  81.     wIDItem := msg.WParam;
  82.     fwMenu := msg.LParamLo;
  83.     hmen := msg.LParamHi;
  84.     resourceID := 0;
  85.  
  86.     menuClosing := ((fwMenu = $0ffff) AND (hmen = 0));
  87.  
  88.     if (fwMenu AND MF_POPUP)<> 0 then
  89.     begin
  90.         if wIDItem = hmenuSystem then
  91.              resourceID := 1
  92.         else if wIDItem =    hmenuFile then resourceID := 2
  93.         else if wIDItem = hmenuEdit then resourceID := 3;
  94.     end
  95.     else
  96.         if (menuClosing = FALSE)then
  97.             resourceID := wIDItem;
  98.  
  99.     DisplayString(resourceID);
  100. end;
  101.  
  102. procedure TStatusBar.DisplayString(resourceID :integer);
  103. var
  104.     r : TRECT;
  105.     s : array [0..128] of char;
  106.     hdci : hdc;
  107. begin
  108.     s[0] := #0;
  109.     if resourceID <> 0 then
  110.     begin
  111.         LoadString(hinstance,resourceID,s,sizeof(s));
  112.     end;
  113.     currentID := resourceID;
  114.     GetClientRect(hwindow, R);
  115.     hdci := GETDC(HWindow);
  116.     OffsetRect(r,1,1);
  117.     FillRect(hdci,r,GetStockObject(LTGRAY_BRUSH));
  118.     FrameRect(hdci,r,GetStockObject(DKGRAY_BRUSH));
  119.  
  120.    
  121.     OffsetRect(r,-1,-1);
  122.     FrameRect(hdci,r,GetStockObject(WHITE_BRUSH));
  123.     setbkmode(hdci,TRANSPARENT);
  124.     EXTTextOut(hDCi,4,0,ETO_CLIPPED,@r,s,lstrlen(s),nil);
  125.     releasedc(hwindow,hdci);    
  126. end;
  127.  
  128. procedure TStatusBar.Paint(PaintDC: HDC; var PaintInfo: TPaintStruct);
  129. begin
  130.     DisplayString(currentID);
  131. end;
  132.  
  133. end.